00100		SUBROUTINE DREDIT
00200		COMMON/ED/K,NEXT,NN,NX,NY,J
00300		COMMON /RZ/RSZ,IPLT,RJB,CENTR
00400		COMMON /RC/MCLEF(400),IST(4000)
00500		COMMON/ZN/SCLEF(400,2),N
00600		COMMON/LL/LL
00700		COMMON/JJJ/JJJ
00800		EQUIVALENCE(M,SCLEF(1,2)),(KK,SCLEF(1,1))
00900		NEXTX=NEXT-1
01400		J=MCLEF(1)
01500	20	IF(K.EQ.'D')GO TO 1
01600	C  MOVE CURSOR TO INSERT POINT, TYPE CR.
01700	9	FORMAT(' SET POINT ',$)
01800		IF(JJJ.EQ.-2)GO TO 131
01900	C  FOR CONTINUING RELATIVE CHANGE
02000	CC	IF(JJJ.EQ.0)JJK=0
02100	5	TYPE 9
02200		ACCEPT 3,L
02210	
02300		IF(L.EQ.'B'.OR.L.EQ.'N')RETURN
02400	C N OR B=BACKUP, J=INSERT OR ALTER TO JUMP, C=ALTER JUMP TO CONT.
02500		IF(L.EQ.' ')GO TO 12
02510		IF(L.NE.'F')GO TO 50
02520		MCLEF(NEXT-1)=MCLEF(NEXT-1)+200000000
02530		RETURN
02540	C ABOVE SET NEW FILL POINT.
02600	50	REREAD 33,ML,MLA
02700		IF(JJJ)JJJ=-2
02800	C TO SET POINT BY NUM(NOT FOR FILLER)	NOT NOW IN!
02900	131	IF(M.GE.0)CALL UNPACK(NEXTX,NX,NY,MCLEF)
03100	C  FOR RELATIVE POS. CHANGE
03200		X=NX+ML
03300		Y=NY+MLA
03400		GO TO 13
03500	12	CALL RDCUR(NX,NY)
03600	130	X=STPT(FLOAT(NX),RJB)
03700		Y=STPT(FLOAT(NY),CENTR)
03800	13	NX=GTPT(X,RJB)
03900		NY=GTPT(Y,CENTR)
04000		CALL SETCUR(NX,NY,0)
04100		IF(K.EQ.0)GO TO 14
04200		NT=NEXT
04300		L=NT
04600	40	FORMAT(' POINT OK? (Y,N,B,J,F OR C) ',$)
04650	C Y=YES,N=NO,B=BACKUP,J=JUMP,F=START FILL,C=CONTINUE(NULLIFY JUMP)
04700		TYPE 4,L,X,Y
04800		TYPE 40
04900		ACCEPT 3,L
04910		IF(L.EQ.'B')RETURN
05000		IF(L.EQ.'N')GO TO 5
05100		IF(K.NE.'A')GO TO 8
05150	C  WHAT IS ABOVE FOR?????
05200		NT=NEXTX
05300		GO TO 7
05400	11	FORMAT(I3,')',2I6,1X$)
05600	CC8	TYPE 19
05700	CC	ACCEPT 3,L
05800	CC	IF(L.EQ.'B')RETURN
05900	8	A=X
06000		B=Y
06100		K=0
06200		GO TO 12
06300	C NOW ASSUMES → IF NO ← POINT FOUND
06400	14	IF(NX.EQ.SCLEF(NT-2,1).AND.NY.EQ.SCLEF(NT-2,2))NT=NT-1
06500	15	X=A
06600		Y=B
06700		J=J+1
06800		DO 6 L=J,NT+1,-1
06900	6	MCLEF(L)=MCLEF(L-1)
07000	7	LL=0
07100		NX=X
07200		NY=Y
07500		IF(MCLEF(NT).GT.100000000.AND.L.NE.'C')LL=(MCLEF(NT)/100000000)*
07512		1 100000000
07525		IF(L.EQ.'J')LL=100000000
07530		IF(L.EQ.'F')LL=200000000
07600		K=MCLEF(NT)
07700		CALL REPACK(NT,NX,NY,MCLEF)
07900		GO TO 100
08000	CC19	FORMAT(' OTHER POINT? ',$)
08100	3	FORMAT(A1)
08200	33	FORMAT(2I)
08300	4	FORMAT(I4,')',2F6.0)
08400	C  NT IS FOR INSERTS
08450	1	IF(J-NEXT)RETURN
08500		DO 10 L=NEXT,J+1
08530		IF(L.EQ.'F')LL=200000000
08600	10	MCLEF(L-1)=MCLEF(L)
08700		J=J-1
08800	100	MCLEF(1)=J
08900		KK=0
09000		IF(MCLEF(2).LT.100000000)MCLEF(2)=MCLEF(2)+100000000
09100		CALL DPYSET(1,IST,4000)
09200		CALL DPYBRT(5)
09300		KK=1
09400		CALL RDRAW(2,MCLEF(1),MCLEF)
09450		CALL DPYOUT(1)
09500	CC	RETURN
09600	CC2	CALL RDCUR(NX,NY)
09700		END
09800	
09900	C*******************************************************
10000		FUNCTION STPT(A,X)
10100		COMMON /RZ/RSZ,IPLT,RJB,CENTR
10200		R=.5
10300		Q=A/RSZ-X
10400		IF(Q)R=-R
10500		STPT=IFIX(Q+R)
10600		RETURN
10700		END
10800	
10900		FUNCTION GTPT(A,X)
11000		COMMON /RZ/RSZ,IPLT,RJB,CENTR
11100		GTPT=(A+X)*RSZ
12400		END
12500	
12600	
12700	
15000		SUBROUTINE SMOOTH(JQ)
15100		COMMON/ED/KX,NEXT,NN,NX,NY,J/LL/L
15200		COMMON /RC/MCLEF(400),IST(4000)
15300		COMMON /RZ/RSZ,IPLT,RJB,CENTR
15400		COMMON /FL/IC,NJ,NQ,RZ,IXRX,XGP,RXGP
15500		DIMENSION BUF2(700),SX(512),SY(512)
15600		COMMON/NFF/NE(513)
15700		DATA INC/10/
15800		RR=RSZ
15900	CC	IF(IPLT.EQ.0)RR=RR*1.7
16000		COMMON X(100),Y(100),N,X1(512),Y1(512),S(100),K
16100		IF(IPLT.EQ.0.AND.JQ.EQ.0)CALL DPYSET(1,IST,4000)
16200		IF(JQ.NE.' ')CALL HYDPOG(1)
16300		JL=0
16400		NOFIL=-1
16500		IF(JQ.EQ.0)NOFIL=0
16600	100	JY=2
16700		IF(IPLT.EQ.0)CALL DPYSET(3,BUF2,700)
16800		J=MCLEF(1)
16900	7	JX=J
17000	8	KX=0
17100		DO 1 K=JY,J
17200		CALL UNPACK(K,JA,JB,MCLEF)
17300		IF(L.GE.100000000.AND.K.GT.JY)GO TO 6
17400	C  JUMP WHEN INVIS. VECT.
17500		KX=KX+1
17600		X(KX)=JA+RJB
17700	1	Y(KX)=JB+CENTR
17800	9	X(KX+1)=999.
17900	4	N=KX
18000		CALL SS
18100		JL=JL+1
18200		JK=JL
18300		SX(JL)=X1(1)*RR
18400		SY(JL)=Y1(1)*RR
18500		CALL LINES(X1(1),Y1(1),3)
18600		DO 5 K=2,512,INC
18700		JL=JL+1
18800		SX(JL)=X1(K)*RR
18900		SY(JL)=Y1(K)*RR
19000		NE(JL)=0
19100	5	CALL LINES(X1(K),Y1(K),2)
19200		IF(SX(JL).NE.SX(JK))SX(JK)=SX(JL)
19300		IF(SY(JL).NE.SY(JK))SY(JK)=SY(JL)
19400		NE(JK)=3
19500	C FOR INVIS. VECTOR
19600		IF(IPLT.EQ.0)CALL DPYOUT(3)
19700	10	IF(JX.NE.J)GO TO 7
19800		CALL SETPOG(1)
19900		IF(NOFIL)RETURN
20000	200	NE(1)=JL
20100		CALL FILLQ(SX,SY,NE)
20200		RETURN
20300	6	JY=K
20400		JX=JY
20500		GO TO 9
20600		END
20700	
20800		SUBROUTINE EDTYP(K,X,Y,JJJ)
20900		TYPE 57
21000		ACCEPT 1,K,X,Y
21100		IF(K.NE.' ')JJJ=0
21200		IF(K.EQ.':'.OR.JJJ)GO TO 2
21300	C  TYPE "A" OR ":" TO ALTER
21400		IF(K.NE.'G')RETURN
21500		JJJ=-1
21600	2	K='A'
21700	57	FORMAT(' TYPE D, A, I OR X ',$)
21800	C  M  N1, N2  =  MOVE SEGS N1 THROUGH N2.
21900	1	FORMAT(A1,2F)
22000		END
22100	
22200		SUBROUTINE ITYP
22300		COMMON /RZ/RSZ,IPLT,RJB,CENTR
22400		COMMON/ED/K,NEXT,NN,NX,NY,J
22500		A=STPT(FLOAT(NX),RJB)
22600		B=STPT(FLOAT(NY),CENTR)
22700		TYPE 1,NN,A,B
22800	1	FORMAT(I4,')',2F6.0)
22900		END
23000	
23100		SUBROUTINE FILLQ(Q,R,N)
23200		DIMENSION Q(1),R(1),N(1)
23300		COMMON /RZ/RSZ,IPLT,RJB,CENTR
23400		M=6
23500		IF(IPLT)M=1
23600	1	RZ=RSZ
23700		RSZ=1.0
23800	CC	IF(IPLT.EQ.0)RSZ=1./1.7
23900		CALL FILLER(Q,R,N,M)
24000		RSZ=RZ
24100		IF(IPLT.GE.0)CALL DPYOUT(1)
24200		END
24300		
24400		SUBROUTINE SAVE(M)
24500		DIMENSION M(1)
24600		J=7
24700		L=8
24800		DO 12 K=1,M(1),8
24900		IF(K+J.LT.M(1))GO TO 12
25000		J=M(1)-K
25100		L=J+1
25200	12	WRITE(1,11)L,(M(NM),NM=K,K+J)
25300		RETURN
25400	11	FORMAT(' 9999',I3,8I10)
25500		END